#!./perl # # newwais.pl -- WAIS search interface # # from wais.pl # # Tony Sanders , Nov 1993 # # Example configuration (in local.conf): # map topdir wais.pl &do_wais($top, $path, $query, "database", "title") # # this script uses a sneaky feature of Mosaic that interpretes a # single text input form with the name 'isindex' (case sensitive) to # the same as a . On non-mosaic clients, you wind up with an # additional query # # Note that I know even less about perl than the other two people # who hacked this, so feel free to send hate mail to pjh@netcom.com # if I did something really bad (or if there is a better way of # grabbing the filename off the end of a path. # $oldLIB = $ENV{"LD_LIBRARY_PATH"}; $ENV{"LD_LIBRARY_PATH"} = "$oldLIB:/usr/ucblib"; #require 'ctime.pl'; $waisq = "./waisq"; $waisd = "/tmp/.wais/wais_CDware"; $src = "wais_CDware"; $title = "Example Data"; # # file type map based on file extension, since all file types # come back type URL # %filetype = ( 'html', 'HTML File', 'ps', 'PostScript Document', 'htm', 'HTML File', 'eps', 'PostScript Document', 'txt','Text File', 'home', 'Home Page on Business Solution CD' ); # # code # sub send_index { print "Content-type: text/html\n\n"; print "\nIndex of ", $title, "\n\n"; print "\n

", $title, "

\n"; print "This is an index of the information on this server. Please\n"; print "type a query in the search dialog.\n

"; print "You may use compound searches, such as: environment AND cgi\n"; print ""; } sub do_wais { # local($top, $path, $query, $src, $title) = @_; # parse stream for (@_){s/\\//g}; local(@query) = @_; local($pquery) = join(" ", @query); local($nquery) = $pquery; $nquery =~ tr/[A-Z]/[a-z]/; if (!(($nquery =~ / and /) || ($nquery =~ / or /))) { $nquery =~ s/ //g; } # # grab a wais source if there is one # local($test) = $ENV{'PATH_INFO'}; if ($test) { $test =~ s/\///; $src = "wais_CDware"; $title = $test; } close STDERR; open(STDERR, ">/dev/null"); print "Content-type: text/html\n\n"; $ENV{'HOME'} = "/"; open(WAISQ, "-|") || exec ($waisq, "-c", $waisd, "-m", 100, "-f", "-", "-S", "$src.src", "-g", $nquery); print "\nSearch of ", $title, "\n\n"; print "\n"; print "\n

CDware Search Results

\n"; print "
\n"; print "Enter keyword(s):\n"; # print "
\n"; print "
\n"; print "$title contains the following\n"; print "items relevant to \`$pquery\':

\n"; print "

\n"; #local($hits, $score, $headline, $lines, $bytes, $type, $date); local($hits, $score, $lines, $bytes, $type, $date); $hits = -1; print "
    "; while () { /:score\s+(\d+)/ && ($score = $1); /:number-of-lines\s+(\d+)/ && ($lines = $1); /:number-of-bytes\s+(\d+)/ && ($bytes = $1); /:type "(.*)"/ && ($type = $1); /:headline "(.*)"/ && ($headline = $1); # XXX /:date "(\d+)"/ && ($date = $1, $hits++, &docdone); } &display; print "
"; close(WAISQ); print "
\n"; print "\n"; } # # THis sub was set up to grab the context of the string. # It needs to be emplemented # sub display { for ($i = 0; $i <= $length_context - 1; $i++ ) { @tmp = split(/,/,@pcontext[$i]); $href = @tmp[1]; $name = @tmp[0]; $ext = @tmp[3]; $filename = $href; $filename =~ s/file:\/\///; #$filename =~ s/\/([^\/]*)$//; #$filename = $1; print "
  • $name"; print "        $filetype{$ext}\n"; # open(IN,$filename) || die "howdy"; # while () { # if ( $_ =~ /$pquery/i ){ #$temporary = $_; #$temporary = s/[^.*$pquery]*$//i; #$temporary = $_; #print "$temporary;
    "; # } # } # close(IN); } } sub docdone { if ($headline =~ /Search produced no result/) { print "
    "; print "Search produced no result."; print "

    Test

    "; print $Test; # print $headline, "

    \n

    ";
# the following was &'safeopen
#        open(WAISCAT, "$waisd/$src.cat") || die "$src.cat: $!";
#        while () {
#            s#(Catalog for database:)\s+.*#$1 Catalyst Catalog on CDware#;
#            s#Headline:\s+(.*)#Headline: $1#;
#            print;
#        }
#        close(WAISCAT);
#        print "\n
    \n"; } else { $docname = $headline; $docname =~ s/\.([^.]*)$//; $extension= $1; $docname =~ s/\/([^\/]*)$//; $docname = $1; if ($docname =~ "^index") { $docname = $headline; $docname =~ s/\/([^\/]*)$//; $docname =~ s/\/([^\/]*)$//; $docname = $1; $extension = "home"; } else { $docname = $1; } @context = ($docname,$headline,$filetype,$extension); @pcontext[$hits] = join (",", @context); } $length_context = @pcontext; $score = $headline = $lines = $bytes = $type = $date = ''; } eval '&do_wais';